home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 06 - 1990 / 06.10 Oct 90 / Mops ƒ / Hanoi Towers Mops < prev    next >
Encoding:
Text File  |  1990-08-21  |  1.8 KB  |  93 lines  |  [TEXT/MACA]
  1. ( Towers of hanoi in Mops )
  2. ( Aug. 90 jl )
  3. : hanoi-towers ; \ for easy forgetting
  4.  
  5. :class tower super( ordered-col )
  6.     rect base
  7.     rect column
  8.     int xcenter
  9.     int ycenter
  10.  
  11.     :M classinit: ( xcenter ycenter -- ) put: ycenter put: xcenter 
  12.     get: xcenter 70 -    get: ycenter 16 - 
  13.     get: xcenter 70 +    get: ycenter    put: base
  14.     get: xcenter 4 -    get: ycenter limit: self 10 * 50 +    -
  15.     get: xcenter 4 +    get: ycenter 16 -    put: column 
  16.     ;M
  17.  
  18.     :M draw: 0 syspat dup fill: base fill: column ;M
  19.     :M getX: get: xcenter ;M
  20.     :M getY: get: ycenter ;M
  21.  
  22. ;class
  23.  
  24. :class disk    super( object )
  25.     int size
  26.     var which
  27.     rect image
  28.     int xc    int yc
  29.  
  30.     :M classinit: ( which size -- )    
  31.     put: size    put: which 
  32.     addr: self    get: which add: ** ;M
  33.  
  34.     :M draw: 
  35.     get: which getX: **    put: xc 
  36.     get: which getY: ** 
  37.     12 - get: which size: ** 10 * - put: yc
  38.     get: xc get: size -    get: yc 4-    
  39.     get: xc get: size +    get: yc 4+    put: image
  40.     3 syspat fill: image    draw: image 
  41.     ;M
  42.  
  43.     :M undraw: 19 syspat fill: image
  44.     get: xc 4- get: yc 4- 
  45.     get: xc 4+ get: yc 4+    put: image
  46.     0 syspat fill: image
  47.     ;M
  48.  
  49.     :M move: { dest -- }
  50.     undraw: self
  51.     addr: self    dest add: **
  52.     get: which size: ** 1-    get: which remove: **
  53.     dest put: which
  54.     draw: self
  55.     ;M
  56.     
  57. ;class
  58.  
  59. 3 array towers
  60.  
  61. handle tw
  62.  
  63. : make.towers { ndisks -- }
  64.     3 0 do i 150 * 100 +    280 ndisks ['] tower newObj: tw
  65.     obj: tw    i to: towers    loop ;
  66.  
  67. : draw.towers
  68.     3 0 do i at: towers draw: ** loop ;
  69.  
  70. : dispose.towers    3 0 do    i at: towers dispose: ** loop ;
  71.  
  72. : hanoi { n start inter finish -- }
  73.     n if    n 1-    start finish inter hanoi
  74.     finish at: towers    start at: towers    last: ** move: **    
  75.     n 1-    inter start finish hanoi
  76.     then
  77. ;
  78.  
  79. : main    { ndisks -- }
  80.     ndisks make.towers    cls draw.towers
  81.     ndisks 0 do 0 at: towers 6 ndisks i - 4* + ['] disk newObj: tw drop 
  82.     0 at: towers    last: ** draw: ** loop
  83. ;
  84.  
  85. : doit
  86.     show: fwind    select: fwind    
  87.     10 main
  88.     10 0 1 2 hanoi
  89. ;
  90.  
  91. : demo doit bye ;
  92.  
  93.